module lnd_comp_mct

! !USES:

  use shr_sys_mod
  use shr_kind_mod     , only: IN=>SHR_KIND_IN, R8=>SHR_KIND_R8, CS=>SHR_KIND_CS
  use shr_file_mod     , only: shr_file_getunit, shr_file_getlogunit, shr_file_getloglevel, &
                               shr_file_setlogunit, shr_file_setloglevel, shr_file_setio, &
                               shr_file_freeunit
  use shr_mpi_mod      , only: shr_mpi_bcast
  use mct_mod
  use esmf_mod

  use dead_data_mod
  use dead_mct_mod
  use dead_mod

  use seq_flds_mod
  use seq_cdata_mod
  use seq_infodata_mod
  use seq_timemgr_mod
  use seq_flds_mod     , only: flds_d2x => seq_flds_l2x_fields, &
                               flds_x2d => seq_flds_x2l_fields, &
                               flds_r2x => seq_flds_r2x_fields, &
                               flds_x2s => seq_flds_x2s_fields, &
                               flds_s2x => seq_flds_s2x_fields
!
! !PUBLIC TYPES:
  implicit none
  save
  private ! except

!--------------------------------------------------------------------------
! Public interfaces
!--------------------------------------------------------------------------

  public :: lnd_init_mct
  public :: lnd_run_mct
  public :: lnd_final_mct

!--------------------------------------------------------------------------
! Private data interfaces
!--------------------------------------------------------------------------

  !--- stdin input stuff ---
  character(CS) :: str                  ! cpp  defined model name
  
  !--- other ---
  integer(IN)   :: dbug = 0             ! debug level (higher is more)
  
  real(R8), pointer :: gbuf(:,:)          ! grid info buffer
  real(R8), pointer :: gbuf_r(:,:)        ! grid info buffer - runoff
  real(R8), pointer :: gbuf_s(:,:)        ! grid info buffer - sno
  
  integer(IN)   :: nproc_x       ! num of i pes (type 3)
  integer(IN)   :: seg_len       ! length of segs (type 4)
  integer(IN)   :: nxg           ! global dim i-direction
  integer(IN)   :: nyg           ! global dim j-direction
  integer(IN)   :: decomp_type   ! data decomp type:

  integer(IN)   :: nproc_x_r      ! num of i pes (type 3) - runoff
  integer(IN)   :: seg_len_r      ! length of segs (type 4) - runoff
  integer(IN)   :: nxg_r          ! global dim i-direction - runoff
  integer(IN)   :: nyg_r          ! global dim j-direction - runoff
  integer(IN)   :: decomp_type_r  ! data decomp type -runoff

  integer(IN)   :: nproc_x_s      ! num of i pes (type 3) - sno
  integer(IN)   :: seg_len_s      ! length of segs (type 4) - sno
  integer(IN)   :: nxg_s          ! global dim i-direction - sno
  integer(IN)   :: nyg_s          ! global dim j-direction - sno
  integer(IN)   :: decomp_type_s  ! data decomp type -sno

  character(CS) :: myModelName = 'lnd'   ! user defined model name
  integer(IN)   :: ncomp =2              ! component index
  integer(IN)   :: my_task               ! my task in mpi communicator mpicom 
  integer(IN)   :: master_task=0         ! task number of master task
  integer(IN)   :: logunit               ! logging unit number

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
CONTAINS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: lnd_init_mct
!
! !DESCRIPTION:
!     initialize dead lnd model
!
! !REVISION HISTORY:
!
! !INTERFACE: ------------------------------------------------------------------

  subroutine lnd_init_mct( EClock, cdata, x2d, d2x, cdata_r, r2x, &
                                   cdata_s, x2s, s2x, NLFilename )

! !INPUT/OUTPUT PARAMETERS:

    type(ESMF_Clock)            , intent(in)    :: EClock
    type(seq_cdata)             , intent(inout) :: cdata
    type(mct_aVect)             , intent(inout) :: x2d, d2x
    type(seq_cdata)             , intent(inout) :: cdata_r
    type(mct_aVect)             , intent(inout) ::      r2x
    type(seq_cdata)             , intent(inout) :: cdata_s
    type(mct_aVect)             , intent(inout) :: x2s, s2x
    character(len=*), optional  , intent(in)    :: NLFilename ! Namelist filename

!EOP

    !--- local variables ---
    integer(IN)   :: unitn       ! Unit for namelist file
    integer(IN)   :: ierr        ! error code
    integer(IN)   :: local_comm  ! local communicator
    integer(IN)   :: mype        ! pe info
    integer(IN)   :: totpe       ! total number of pes
    integer(IN), allocatable :: gindex(:)   ! global index
    integer(IN), allocatable :: gindex_r(:) ! global index - runoff
    integer(IN), allocatable :: gindex_s(:) ! global index - sno

    integer(IN)                           :: COMPID
    integer(IN)                           :: mpicom
    integer(IN)                           :: lsize, lsize_r, lsize_s
    type(seq_infodata_type), pointer :: infodata
    type(mct_gsMap)             , pointer :: gsMap
    type(mct_gGrid)             , pointer :: dom
    type(mct_gsMap)             , pointer :: gsMap_r
    type(mct_gGrid)             , pointer :: dom_r
    type(mct_gsMap)             , pointer :: gsMap_s
    type(mct_gGrid)             , pointer :: dom_s
    integer(IN)   :: shrlogunit, shrloglev ! original log unit and level

    !--- formats ---
    character(*), parameter :: F00   = "('(lnd_init_mct) ',8a)"
    character(*), parameter :: F01   = "('(lnd_init_mct) ',a,4i8)"
    character(*), parameter :: F02   = "('(lnd_init_mct) ',a,4es13.6)"
    character(*), parameter :: F03   = "('(lnd_init_mct) ',a,i8,a)"
    character(*), parameter :: F90   = "('(lnd_init_mct) ',73('='))"
    character(*), parameter :: F91   = "('(lnd_init_mct) ',73('-'))"
    character(*), parameter :: subName = "(lnd_init_mct) "
!-------------------------------------------------------------------------------

    ! Set cdata pointers

    call seq_cdata_setptrs(cdata, ID=COMPID, mpicom=mpicom, &
         gsMap=gsMap, dom=dom, infodata=infodata)

    call seq_cdata_setptrs(cdata_r, &
         gsMap=gsMap_r, dom=dom_r)

    call seq_cdata_setptrs(cdata_s, &
         gsMap=gsMap_s, dom=dom_s)

    call mpi_comm_rank(mpicom, my_task, ierr)

    !--- open log file ---
    if (my_task == master_task) then
       logUnit = shr_file_getUnit()
       call shr_file_setIO('lnd_modelio.nml',logUnit)
    else
       logUnit = 6
    endif

   !----------------------------------------------------------------------------
   ! Reset shr logging to my log file
   !----------------------------------------------------------------------------
   call shr_file_getLogUnit (shrlogunit)
   call shr_file_getLogLevel(shrloglev)
   call shr_file_setLogUnit (logUnit)

    ! read the namelist input (used to configure model)

    nxg            =  -9999
    nyg            =  -9999
    nproc_x        =  -9999
    seg_len        =  -9999
    decomp_type    =  -9999

    nxg_r          =  -9999
    nyg_r          =  -9999
    nproc_x_r      =  -9999
    seg_len_r      =  -9999
    decomp_type_r  =  -9999

    nxg_s          =  -9999
    nyg_s          =  -9999
    nproc_x_s      =  -9999
    seg_len_s      =  -9999
    decomp_type_s  =  -9999

    if (my_task == master_task) then
       unitn = shr_file_getUnit()
       open( unitn, file='xlnd_in', status='old' )
       read(unitn,*) nxg
       read(unitn,*) nyg
       read(unitn,*) decomp_type
       read(unitn,*) nproc_x
       read(unitn,*) seg_len

       read(unitn,*) nxg_r
       read(unitn,*) nyg_r
       read(unitn,*) decomp_type_r
       read(unitn,*) nproc_x_r
       read(unitn,*) seg_len_r
       close (unitn)
       call shr_file_freeUnit(unitn)
    endif

    call shr_mpi_bcast(nxg        ,mpicom,'xlnd nxg')
    call shr_mpi_bcast(nyg        ,mpicom,'xlnd nyg')
    call shr_mpi_bcast(decomp_type,mpicom,'xlnd decomp_type')
    call shr_mpi_bcast(nproc_x    ,mpicom,'xlnd nproc_x')
    call shr_mpi_bcast(seg_len    ,mpicom,'xlnd seg_len')

    call shr_mpi_bcast(nxg_r        ,mpicom,'xlnd nxg_r')
    call shr_mpi_bcast(nyg_r        ,mpicom,'xlnd nyg_r')
    call shr_mpi_bcast(decomp_type_r,mpicom,'xlnd decomp_type_r')
    call shr_mpi_bcast(nproc_x_r    ,mpicom,'xlnd nproc_x_r')
    call shr_mpi_bcast(seg_len_r    ,mpicom,'xlnd seg_len_r')

    nxg_s          =  nxg
    nyg_s          =  nyg
    nproc_x_s      =  nproc_x
    seg_len_s      =  seg_len
    decomp_type_s  =  decomp_type

    if (my_task == master_task) then
       write(logunit,*  ) ' Read in Xlnd input from file= xlnd_in'
       write(logunit,F00)
       write(logunit,F00) '           Model  :  ',trim(myModelName)
       write(logunit,F01) '             NGX  :  ',nxg
       write(logunit,F01) '             NGY  :  ',nyg
       write(logunit,F01) '   Decomposition  :  ',decomp_type
       write(logunit,F03) '   Num pes in X   :  ',nproc_x,'  (type 3 only)'
       write(logunit,F03) '   Segment Length :  ',seg_len,'  (type 11 only)'
       write(logunit,F00)
       write(logunit,F01) '           NGX_R  :  ',nxg_r
       write(logunit,F01) '           NGY_R  :  ',nyg_r
       write(logunit,F01) ' Decomposition_R  :  ',decomp_type_r
       write(logunit,F03) ' Num pes in X _R  :  ',nproc_x_r,'  (type 3 only)'
       write(logunit,F03) ' Segment Length_R :  ',seg_len_r,'  (type 11 only)'
       write(logunit,F00)
       write(logunit,F01) '           NGX_S  :  ',nxg_s
       write(logunit,F01) '           NGY_S  :  ',nyg_s
       write(logunit,F01) ' Decomposition_S  :  ',decomp_type_s
       write(logunit,F03) ' Num pes in X _S  :  ',nproc_x_s,'  (type 3 only)'
       write(logunit,F03) ' Segment Length_S :  ',seg_len_s,'  (type 11 only)'
       call shr_sys_flush(logunit)
    end if

    ! Set flag to specify dead components

    call seq_infodata_PutData(infodata, dead_comps=.true., lnd_present=.true., &
      lnd_prognostic=.true., rof_present=.true., sno_present=.true., sno_prognostic=.true., &
      lnd_nx=nxg, lnd_ny=nyg, rof_nx=nxg_r, rof_ny=nyg_r, sno_nx=nxg_s, sno_ny=nyg_s)

    ! Determine communicator groups and sizes

    local_comm = mpicom
    call MPI_COMM_RANK(local_comm,mype ,ierr)
    call MPI_COMM_SIZE(local_comm,totpe,ierr)

    ! Initialize grid

    call dead_setNewGrid(decomp_type  ,nxg  ,nyg  ,totpe,mype,lsize  ,gbuf  ,seg_len  ,nproc_x)
    call dead_setNewGrid(decomp_type_r,nxg_r,nyg_r,totpe,mype,lsize_r,gbuf_r,seg_len_r,nproc_x_r)
    call dead_setNewGrid(decomp_type_s,nxg_s,nyg_s,totpe,mype,lsize_s,gbuf_s,seg_len_s,nproc_x_s)

    ! Initialize MCT global seg map

    allocate(gindex(lsize))
    gindex(:) = gbuf(:,dead_grid_index)
    call mct_gsMap_init( gsMap, gindex, mpicom, COMPID, lsize, nxg*nyg)
    deallocate(gindex)

    allocate(gindex_r(lsize_r))
    gindex_r(:) = gbuf_r(:,dead_grid_index)
    call mct_gsMap_init( gsMap_r, gindex_r, mpicom, COMPID, lsize_r, nxg_r*nyg_r)
    deallocate(gindex_r)

    allocate(gindex_s(lsize_s))
    gindex_s(:) = gbuf_s(:,dead_grid_index)
    call mct_gsMap_init( gsMap_s, gindex_s, mpicom, COMPID, lsize_s, nxg_s*nyg_s)
    deallocate(gindex_s)

    ! Initialize MCT domain

    call dead_domain_mct(mpicom, gbuf, gsMap, dom)
    call dead_domain_mct(mpicom, gbuf_r, gsMap_r, dom_r)
    call dead_domain_mct(mpicom, gbuf_s, gsMap_s, dom_s)

    ! Initialize MCT attribute vectors

    call mct_aVect_init(d2x, rList=flds_d2x, lsize=lsize)
    call mct_aVect_zero(d2x)

    call mct_aVect_init(x2d, rList=flds_x2d, lsize=lsize)
    call mct_aVect_zero(x2d)

    call mct_aVect_init(r2x, rList=flds_r2x, lsize=lsize_r)
    call mct_aVect_zero(r2x)

    call mct_aVect_init(x2s, rList=flds_x2s, lsize=lsize_s)
    call mct_aVect_zero(x2s)

    call mct_aVect_init(s2x, rList=flds_s2x, lsize=lsize_s)
    call mct_aVect_zero(s2x)

    ! Get relevant data to send back to driver

!!    call lnd_run_mct(EClock, cdata, x2d, d2x, cdata_r, r2x, cdata_s, x2s, s2x)

    !----------------------------------------------------------------------------
    ! Reset shr logging to original values
    !----------------------------------------------------------------------------
    call shr_file_setLogUnit (shrlogunit)
    call shr_file_setLogLevel(shrloglev)
    call shr_sys_flush(logunit)

end subroutine lnd_init_mct

!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: lnd_run_mct
!
! !DESCRIPTION:
!     run method for dead lnd model
!
! !REVISION HISTORY:
!
! !INTERFACE: ------------------------------------------------------------------

subroutine lnd_run_mct( EClock, cdata,  x2d, d2x, cdata_r, r2x, cdata_s, x2s, s2x)

! !INPUT/OUTPUT PARAMETERS:

   type(ESMF_Clock)            ,intent(in)    :: EClock
   type(seq_cdata)             ,intent(inout) :: cdata
   type(mct_aVect)             ,intent(inout) :: x2d        ! driver -> dead
   type(mct_aVect)             ,intent(inout) :: d2x        ! dead   -> driver
   type(seq_cdata)             ,intent(in)    :: cdata_r
   type(mct_aVect)             ,intent(inout) :: r2x
   type(seq_cdata)             ,intent(inout) :: cdata_s
   type(mct_aVect)             ,intent(inout) :: x2s
   type(mct_aVect)             ,intent(inout) :: s2x

!EOP

   !--- local ---
   integer(IN)   :: CurrentYMD        ! model date
   integer(IN)   :: CurrentTOD        ! model sec into model date
   integer(IN)   :: n                 ! indices
   integer(IN)   :: nf                ! fields loop index
   integer(IN)   :: nl                ! land frac index
   integer(IN)   :: kl                ! index of landfrac
   integer(IN)   :: lsize,lsize_r,lsize_s     ! size of attr vect
   real(R8)      :: lat               ! latitude
   real(R8)      :: lon               ! longitude
   integer(IN)   :: shrlogunit, shrloglev ! original log unit and level
   logical       :: glcrun_alarm      ! is glc going to run now
   type(seq_infodata_type), pointer :: infodata
   integer       :: nflds_d2x, nflds_x2d
   integer       :: nflds_s2x, nflds_x2s
   integer       :: nflds_r2x

   character(*), parameter :: F00   = "('(lnd_run_mct) ',8a)"
   character(*), parameter :: F04   = "('(lnd_run_mct) ',2a,2i8,'s')"
   character(*), parameter :: subName = "(lnd_init_mct) "
!-------------------------------------------------------------------------------

  !----------------------------------------------------------------------------
  ! Reset shr logging to my log file
  !----------------------------------------------------------------------------
   call shr_file_getLogUnit (shrlogunit)
   call shr_file_getLogLevel(shrloglev)
   call shr_file_setLogUnit (logUnit)

   call seq_cdata_setptrs(cdata, infodata=infodata)
   call seq_infodata_getData(infodata, glcrun_alarm=glcrun_alarm)

   lsize = mct_avect_lsize(x2d)
   lsize_r = mct_avect_lsize(r2x)
   lsize_s = mct_avect_lsize(x2s)
   nflds_d2x = mct_avect_nRattr(d2x)
   nflds_x2d = mct_avect_nRattr(x2d)
   nflds_r2x = mct_avect_nRattr(r2x)
   nflds_s2x = mct_avect_nRattr(s2x)
   nflds_x2s = mct_avect_nRattr(x2s)

   ! UNPACK

   do nf=1,nflds_x2d
   do n=1,lsize
!     ?? = x2d%rAttr(nf,n)
   enddo
   enddo

   do nf=1,nflds_x2s
   do n=1,lsize_s
!     ?? = x2s%rAttr(nf,n)
   enddo
   enddo

   ! PACK
   
   do nf=1,nflds_d2x
   do n=1,lsize
      lon = gbuf(n,dead_grid_lon)
      lat = gbuf(n,dead_grid_lat)
      d2x%rAttr(nf,n) = (nf*100)                   &
           *  cos (SHR_CONST_PI*lat/180.0_R8)       &
           *  sin((SHR_CONST_PI*lon/180.0_R8)       &
           -      (ncomp-1)*(SHR_CONST_PI/3.0_R8) ) &
           + (ncomp*10.0_R8)
   enddo
   enddo
   
   kl = mct_aVect_indexRA(d2x,"Sl_landfrac",perrWith=subName)
   d2x%rAttr(kl,:) = min(1.0_R8,max(0.0_R8,d2x%rAttr(kl,:)))

   do nf=1,nflds_r2x
   do n=1,lsize_r
      r2x%rAttr(nf,n) = (nf+1) * 1.0_r8
   enddo
   enddo

   if (glcrun_alarm) then
      if (my_task == master_task) then
        call seq_timemgr_EClockGetData( EClock, curr_ymd=CurrentYMD, curr_tod=CurrentTOD)
        write(logunit,F04) trim(myModelName),': glcrun_alarm is true, update s2x fields ', &
                           CurrentYMD,CurrentTOD
      endif
      do nf=1,nflds_s2x
      do n=1,lsize_s
         lon = gbuf_s(n,dead_grid_lon)
         lat = gbuf_s(n,dead_grid_lat)
         s2x%rAttr(nf,n) = (nf*100)                   &
              *  cos (SHR_CONST_PI*lat/180.0_R8)      &
              *  cos (SHR_CONST_PI*lat/180.0_R8)      &
              *  sin (SHR_CONST_PI*lon/180.0_R8)      &
              *  sin (SHR_CONST_PI*lon/180.0_R8)      &
              + (ncomp*10.0_R8)
      enddo
      enddo
   endif

   ! log output for model date

   if (my_task == master_task) then
      call seq_timemgr_EClockGetData( EClock, curr_ymd=CurrentYMD, curr_tod=CurrentTOD)
      write(logunit,F04) trim(myModelName),': model date ', CurrentYMD,CurrentTOD
      call shr_sys_flush(logunit)
   end if
      
   !----------------------------------------------------------------------------
   ! Reset shr logging to original values
   !----------------------------------------------------------------------------
   call shr_file_setLogUnit (shrlogunit)
   call shr_file_setLogLevel(shrloglev)
   call shr_sys_flush(logunit)

end subroutine lnd_run_mct

!===============================================================================
!BOP ===========================================================================
!
! !IROUTINE: lnd_final_mct
!
! !DESCRIPTION:
!     finalize method for dead lnd model
!
! !REVISION HISTORY:
!
! !INTERFACE: ------------------------------------------------------------------
!
subroutine lnd_final_mct()

!EOP

   !--- formats ---
   character(*), parameter :: F00   = "('(lnd_final) ',8a)"
   character(*), parameter :: F91   = "('(lnd_final) ',73('-'))"
   character(*), parameter :: subName = "(lnd_final) "

!-------------------------------------------------------------------------------
!
!-------------------------------------------------------------------------------

   if (my_task == master_task) then
      write(logunit,F91) 
      write(logunit,F00) trim(myModelName),': end of main integration loop'
      write(logunit,F91) 
   end if
      
 end subroutine lnd_final_mct
!===============================================================================

end module lnd_comp_mct
